home *** CD-ROM | disk | FTP | other *** search
/ NASA Climatology Interdisciplinary Data Collection / NASA Climatology Interdisciplinary Data Collection - Disc 4.iso / software / grads / lib / philo.gs < prev    next >
Encoding:
Text File  |  1998-04-23  |  2.8 KB  |  195 lines

  1. function philo(args)
  2.  
  3. var=subwrd(args,1)
  4. hlfmt=subwrd(args,2)
  5. hlpcntl=subwrd(args,3)
  6.  
  7. 'q gxinfo'
  8. card=sublin(result,2)
  9. pgx=subwrd(card,4)
  10. pgy=subwrd(card,6)
  11.  
  12. card=sublin(result,3)
  13. xlp=subwrd(card,4)
  14. xrp=subwrd(card,6)
  15.  
  16. card=sublin(result,4)
  17. ybp=subwrd(card,4)
  18. ytp=subwrd(card,6)
  19.  
  20. *
  21. *    defaults to philo
  22. *
  23. if(hlfmt='' | hlfmt='hlfmt') ; hlfmt='"i5"' ; endif
  24. if(hlpcntl='' | hlpcntl = 'hlpcntl') ; hlpcntl='0.25' ; endif
  25.  
  26. *
  27. *    plotting params
  28. *
  29. *    the mark
  30. hlmk=1
  31. hlmksiz=0.05
  32. hlmkthk=0.05
  33. hlmkcol=1
  34.  
  35. hlchoffx=0.0
  36. hlchoffy=0.10
  37.  
  38. hlchsizl=0.10
  39. hlchcoll=1
  40. hlchthkl=6
  41. hlchfntl=5
  42.  
  43. hlchsizh=0.10
  44. hlchcolh=1
  45. hlchthkh=6
  46. hlchfnth=5
  47.  
  48. hlvlsiz=0.06
  49. hlvlcol=1
  50. hlvlthk=6
  51.  
  52. pcnth=1
  53. pcntl=1
  54.  
  55. '!rm udf.grhilo.out'
  56.  
  57. 'd grhilo('var','hlfmt','hlpcntl')'
  58.  
  59. rc=read(udf.grhilo.out)
  60. card=sublin(rc,2)
  61. iok=sublin(rc,1)
  62. if(iok!=0) ; return; endif
  63. nh=subwrd(card,1)
  64. nl=subwrd(card,2)
  65. rmgh=subwrd(card,3)
  66. rmlh=subwrd(card,4)
  67. rmgl=subwrd(card,5)
  68. rmll=subwrd(card,6)
  69.  
  70. *
  71. *    read and plot H's
  72. *
  73.  
  74. i=1
  75. while(i<=nh)
  76.   rc=read(udf.grhilo.out)
  77.   card=sublin(rc,2)
  78.   iok=sublin(rc,1)
  79.   chrhl.i=subwrd(card,1)
  80.   lonhl.i=subwrd(card,2)
  81.   lathl.i=subwrd(card,3)
  82.   valhl.i=subwrd(card,4)
  83.   grdhl.i=subwrd(card,5)
  84.   lplhl.i=subwrd(card,6)
  85.   i=i+1
  86. endwhile
  87.  
  88. nhp=nint(nh*pcnth)
  89. i=1
  90. while(i<=nhp)
  91.  
  92.   if(lplhl.i >= rmlh)
  93.   'q w2xy 'lonhl.i' 'lathl.i
  94.   xhl=subwrd(result,3)
  95.   yhl=subwrd(result,6)
  96.   if( (xhl > xlp) & (xhl < xrp) & (yhl > ybp) & (yhl < ytp) ) 
  97.  
  98.   'set line 'hlmkcol
  99.   'draw mark 'hlmk' 'xhl' 'yhl' 'hlmksiz
  100.  
  101.   xhlc=xhl+hlchoffx
  102.   yhlc=yhl+hlchoffy
  103.  
  104.   'set string 'hlchcolh' c 'hlchthkh
  105.   'set strsiz 'hlchsizh
  106.   'draw string 'xhlc' 'yhlc' `'hlchfnth%chrhl.i
  107.  
  108.   xhlv=xhl-hlchoffx
  109.   yhlv=yhl-hlchoffy
  110.  
  111.   'set string 'hlvlcol' c 'hlvlthk
  112.   'set strsiz 'hlvlsiz
  113.   'draw string  'xhlv' 'yhlv' 'valhl.i
  114.  
  115.   endif
  116.   endif
  117.  
  118.   i=i+1
  119.  
  120. endwhile
  121.  
  122. *
  123. *    read and plot L's
  124. *
  125.  
  126. i=1
  127. while(i<=nl)
  128.   rc=read(udf.grhilo.out)
  129.   card=sublin(rc,2)
  130.   iok=sublin(rc,1)
  131.   chrhl.i=subwrd(card,1)
  132.   lonhl.i=subwrd(card,2)
  133.   lathl.i=subwrd(card,3)
  134.   valhl.i=subwrd(card,4)
  135.   grdhl.i=subwrd(card,5)
  136.   lplhl.i=subwrd(card,6)
  137.   i=i+1
  138. endwhile
  139.  
  140.  
  141. nlp=nint(nl*pcntl)
  142. i=1
  143. while(i<=nlp)
  144.  
  145.   if(lplhl.i >= rmll) 
  146.  
  147.   'q w2xy 'lonhl.i' 'lathl.i
  148.  
  149.   xhl=subwrd(result,3)
  150.   yhl=subwrd(result,6)
  151.  
  152.   if( (xhl > xlp) & (xhl < xrp) & (yhl > ybp) & (yhl < ytp) ) 
  153.  
  154.   'set line 'hlmkcol
  155.   'draw mark 'hlmk' 'xhl' 'yhl' 'hlmksiz
  156.  
  157.   xhlc=xhl+hlchoffx
  158.   yhlc=yhl+hlchoffy
  159.  
  160.   'set string 'hlchcoll' c 'hlchthkl
  161.   'set strsiz 'hlchsizl
  162.   'draw string 'xhlc' 'yhlc' `'hlchfntl%chrhl.i
  163.  
  164.   xhlv=xhl-hlchoffx
  165.   yhlv=yhl-hlchoffy
  166.  
  167.   'set string 'hlvlcol' c 'hlvlthk
  168.   'set strsiz 'hlvlsiz
  169.   'draw string  'xhlv' 'yhlv' 'valhl.i
  170.  
  171.   endif
  172.   endif
  173.  
  174.   i=i+1
  175.  
  176. endwhile
  177.  
  178.  
  179. return
  180. *
  181. *-------------------------- nint ------------------
  182. *
  183. function nint(i0)
  184.   i0=i0+0.5
  185.   i=0
  186.   while(i<12)
  187.     i=i+1
  188.     if(substr(i0,i,1)='.')
  189.       i0=substr(i0,1,i-1)
  190.       break
  191.     endif
  192.   endwhile
  193. return(i0)
  194.  
  195.